Aminet 40/Aminet 40 (2000)(Schatztruhe)[!][Dec 2000].iso/Aminet/misc/emu/ATUtilities.lha/ATUtilities/gdos.mod

Text File | 2000-09-26 | 6.2 KB | 379 lines

(*$ S- *)
MODULE GDOS;

FROM SYSTEM  IMPORT ASSEMBLER,BYTE,WORD,ADDRESS,ADR,OFS,SEG,SEGMENT,OFFSET;
FROM Storage IMPORT ALLOCATE,DEALLOCATE;
FROM System  IMPORT AX,BX,CX,DX,ES,DS,SI,DI,Trap,XTrap,Move,SetVector,GetVector,
                    TermProcedure,Terminate,InstallRTErrorHandler,
                    UninstallRTErrorHandler;
FROM InOut   IMPORT WriteString,WriteCard,WriteLn;
FROM Strings IMPORT Length;

CONST
 gadgetBoolean = 1;
 gadgetToggle  = 2;
 gadgetString  = 3;
 gadgetClose   = 4;
 gadgetMenu    = 20;

TYPE
 GDOS = RECORD
  oldColors  : ARRAY [0..(16*3)] OF BYTE;
  mouseLock  : CARDINAL;
  graphics64 : ADDRESS;
 END (* RECORD *);

 Menu = RECORD
  leftEdge,width : CARDINAL;
  text           : ARRAY [0..19] OF CHAR;
  enabled        : BOOLEAN;
 END (* RECORD *);

 MenuItem = RECORD
  text       : ARRAY [0..29] OF CHAR;
  checkit    : BOOLEAN;
  checked    : BOOLEAN;
  enabled    : BOOLEAN;
 END (* RECORD *);

 Gadget = RECORD
  leftEdge,topEdge,
  width,height       : CARDINAL;
  type               : CARDINAL;
  text               : ADDRESS;
  undo               : ADDRESS;
  borderless         : BOOLEAN;
  menu               : POINTER TO Menu;
 END (* RECORD *);

VAR gdos : GDOS;
    a,b  : INTEGER;
    gfx  : ADDRESS;


PROCEDURE Abbruch(text : ARRAY OF CHAR);
BEGIN
 WriteString("NICHT BEHEBBARER FEHLER BEI DER PROGRAMMAUSFÜHRUNG:");
 WriteLn;
 WriteString(text);
 WriteLn;
 WriteLn;
 HALT;
END Abbruch;

PROCEDURE CheckVGA;
BEGIN
 AX := 01A00H;
 Trap(010H);

 IF ((AX MOD 256)=01AH) THEN
  WriteString("VGA Okay");
  WriteLn;
 ELSE
  Abbruch("Dieses Programm benötigt eine VGA-Karte!");
 END (* IF *);
END CheckVGA;

PROCEDURE CheckMouse;
VAR maus : ADDRESS;
BEGIN
 GetVector(033H,maus);
 IF (maus=NIL) THEN
  Abbruch("Dieses Programm benötigt einen Maustreiber an Interrupt $33!");
 END (* IF *);
 AX := 0;
 Trap(033H);
 IF (AX=0) THEN
  Abbruch("Fehler beim installieren der Maus!");
 END (* IF *);
END CheckMouse;

PROCEDURE MouseOn;
BEGIN
 IF (gdos.mouseLock=0) THEN
  AX := 1;
  Trap(033H);
 END (* IF *);
END MouseOn;

PROCEDURE MouseOff;
BEGIN
 IF (gdos.mouseLock=0) THEN
  AX := 2;
  Trap(033H);
 END (* IF *);
END MouseOff;

PROCEDURE MouseLock;
BEGIN
 INC(gdos.mouseLock);
END MouseLock;

PROCEDURE MouseUnlock;
BEGIN
 DEC(gdos.mouseLock);
END MouseUnlock;

PROCEDURE WaitForKey;
BEGIN
 AX := 0;
 Trap(016H);
END WaitForKey;

PROCEDURE SetRGB(c,r,g,b : CARDINAL);
BEGIN
 AX := 01010H;
 BX := c;
 CX := g*256+b;
 DX := r*256;
 Trap(010H);
END SetRGB;

PROCEDURE PutChar(farbe,x,y : CARDINAL; zeichen : CHAR);
BEGIN
 ASM
  MOV AH,2
  MOV BX,x
  MOV DL,BL
  MOV BX,y
  MOV DH,BL
  MOV BX,0
  INT 10H
  MOV AH,9
  MOV CX,1
  MOV AL,zeichen
  MOV DX,farbe
  MOV BL,DL
  MOV BH,0
  INT 10H
 END (* ASM *);
END PutChar;

PROCEDURE Text(farbe,x,y : CARDINAL; text : ARRAY OF CHAR);
VAR i : CARDINAL;
BEGIN
 MouseOff;

 FOR i := 0 TO Length(text)-1 DO
  PutChar(farbe,x+i,y,text[i]);
 END (* FOR *);

 MouseOn;
END Text;

PROCEDURE WritePixel(farbe,x,y : CARDINAL);
BEGIN
 ASM
  MOV DX,farbe
  MOV AL,DL
  MOV AH,0CH
  MOV BH,0
  MOV DX,y
  MOV CX,x
  INT 10H
 END (* ASM *);
END WritePixel;

PROCEDURE DrawX(farbe,x,y,xw : CARDINAL);
VAR z : CARDINAL;
BEGIN
 FOR z := x TO xw DO
  WritePixel(farbe,z,y);
 END (* FOR *);
END DrawX;

PROCEDURE DrawY(farbe,x,y,yw : CARDINAL);
VAR z : CARDINAL;
BEGIN
 FOR z := y TO yw DO
  WritePixel(farbe,x,z);
 END (* FOR *);
END DrawY;

PROCEDURE DrawBorder(fp,bp,x,y,w,h : CARDINAL);
VAR i : CARDINAL;
BEGIN
 MouseOff;
 DrawX(fp,x,y,x+w);
 DrawY(fp,x,y,y+h);
 DrawX(bp,x+1,y+h,x+w-1);
 DrawY(bp,x+w,y+1,y+h-1);
 MouseOn;
END DrawBorder;

PROCEDURE OpenScreen(mode : INTEGER);
BEGIN
 AX := 01017H;
 BX := 0;
 CX := 16;
 ES := SEGMENT(gdos.oldColors);
 DX := OFFSET(gdos.oldColors);
 XTrap(010H);
 AX := mode;
 Trap(010H);
 SetRGB(0,180,180,180);
 SetRGB(1,255,255,255);
 SetRGB(2,0,0,0);
 SetRGB(3,255,255,85);
 gdos.mouseLock  := 0;
 ALLOCATE(gdos.graphics64,0FFFFH);
 IF (gdos.graphics64 = NIL) THEN
  CloseScreen;
  Abbruch("Es stehen keine 64 KBytes Speicher mehr zur Verfügung!");
 END (* IF *);
 MouseOn;
END OpenScreen;

PROCEDURE CloseScreen;
BEGIN
 MouseOff;
 AX := 3;
 Trap(010H);
 IF (gdos.graphics64 # NIL) THEN
  DEALLOCATE(gdos.graphics64,0FFFFH);
 END (* IF *);
 AX := 01012H;
 BX := 0;
 CX := 16;
 ES := SEGMENT(gdos.oldColors);
 DX := OFFSET(gdos.oldColors);
 XTrap(010H);
 AX := 0;
 Trap(033H);
END CloseScreen;

(* ----------- Hauptprogramm ------------------ *)

PROCEDURE RTErrorHandler(fehler : CARDINAL; adresse : ADDRESS);
BEGIN
 CloseScreen;
 WriteString("NICHT BEHEBBARER FEHLER BEI DER PROGRAMMAUSFÜHRUNG!");
 WriteLn;
 WriteString("Abbruch durch Modula-2 RunTime-Fehler #");
 WriteCard(fehler,1);
 WriteLn;
 WriteLn;
END RTErrorHandler;

PROCEDURE Terminator;
BEGIN
 WriteString("bye!");
 WriteLn;
END Terminator;

PROCEDURE Video2Video;
BEGIN
 ASM
  MOV AX,0A000H
  MOV ES,AX
  MOV DS,AX
  MOV SI,0
  MOV DI,19200
  MOV CX,12800
  CLD

  MOV DX,03CEH
  MOV AX,0105H
  OUT DX,AX

  REP MOVSB
 END;
END Video2Video;

PROCEDURE Test(t : CHAR; u : CARDINAL);
VAR arr : BYTE;
    seg : CARDINAL;
    ofs : CARDINAL;
BEGIN
 seg := gdos.graphics64.SEG;
 ofs := gdos.graphics64.OFS;
 ASM
  MOV AX,0A000H
  MOV BX,seg
  MOV DS,AX
  MOV SI,0
  MOV ES,BX
  MOV DI,ofs

  MOV CX,19200


  MOV DX,03CEH
  MOV AX,0005H
  OUT DX,AX

  MOV DX,03CEH
  MOV AH,t
  MOV AL,04H
  OUT DX,AX

 MOV DX,03C4H
 MOV AL,02H
 MOV BX,u
 MOV AH,BL
 OUT DX,AX

x:
  MOV BL,DS:[SI]
  MOV ES:[DI],BL

  MOV BL,DS:[0]
  MOV BL,DS:[100]
  MOV BL,DS:[200]
  MOV BL,DS:[321]

  MOV BL,ES:[DI]
  MOV DS:[SI+19200],BL

  ADD SI,1
  ADD DI,1
  SUB CX,1
  CMP CX,0
  JNE x

  MOV DX,03C4H
  MOV AX,0F02H
  OUT DX,AX

 END;
END Test;


BEGIN

 CheckVGA();
 CheckMouse();
 OpenScreen(012H);
 TermProcedure(Terminator);
 InstallRTErrorHandler(RTErrorHandler);

 (* ------------------------------------------ *)

gfx := gdos.graphics64;

 DrawBorder(1,2,50,50,500,300);

 DrawBorder(1,2,1,10,638,460);
 DrawBorder(2,1,2,11,636,458);
 DrawBorder(1,2,1,11,638,20);

 FOR a := 1 TO 15 DO
  Text(a,10,a+5,"Graphical DOS User Interface - Version 0.01");
 END;

 Test(0C,1);
 Test(1C,2);
 Test(2C,4);
 Test(3C,8);


 WaitForKey;

 (* ------------------------------------------ *)

 CloseScreen;
 UninstallRTErrorHandler;
 Terminate(0);

END GDOS.